home *** CD-ROM | disk | FTP | other *** search
/ Developer CD Series 1996 February: Tool Chest / Apple Developer CD Series Tool Chest February 1996 (Apple Computer)(1996).iso / Tool Chest / Devices / Apple Desktop Bus / ADBLister / ADBLister.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1990-09-14  |  4.6 KB  |  163 lines  |  [TEXT/TPAS]
  1. PROGRAM ADBLister;
  2.  
  3. {Cameron Birse, Macintosh Technical Support}
  4.  
  5. uses Memtypes,QuickDraw,OSIntf,ToolIntf;
  6. TYPE
  7.     SysEnvRec      =       RECORD
  8.                 environsVersion:    INTEGER;
  9.                 machineType:           INTEGER;
  10.                 systemVersion:         INTEGER;
  11.                 processor:                INTEGER;
  12.                 hasFPU:                      BOOLEAN;
  13.                 hasColorQD:               BOOLEAN;
  14.                 keyBoardType:          INTEGER;
  15.                 atDrvrVersNum:         INTEGER;
  16.                 sysVRefNum:               INTEGER;
  17.                 END;
  18.     
  19.     fourBytes = packed array [0..3] of byte;
  20.     
  21. CONST
  22.     CurrentA5 = $904;
  23.  
  24. VAR
  25.           err            : Integer;
  26.           NumDevs        : integer;
  27.           DevBlock    : ADBDataBlock;
  28.           Addrs        : ADBAddress;
  29.           CmdNum        : integer;
  30.           ADBData : str255;
  31.     GotLEDs, CompTrue, gotADB        : boolean;
  32.           Count, opCount, timer : integer;
  33.           finalTicks : longint;
  34.           TimeOut : integer;
  35.     TheWorld : SysEnvRec;
  36.     a : char;
  37.     MyA5,R3Data : longint;
  38.     ParseData : fourBytes;
  39.     
  40.     {------------------------------------------------------------------------------------}
  41.     
  42. PROCEDURE Debugger; INLINE $A9FF;
  43.  
  44. FUNCTION SysEnvirons(versionRequested: INTEGER; VAR theWorld: SysEnvRec): OSErr;
  45.     INLINE $205f,$301f, $A090, $3e80;
  46.   
  47. PROCEDURE ShutDwnStart;
  48.     INLINE $3F3C,$0002,$A895;
  49.  
  50. PROCEDURE PushA5;
  51.     INLINE  $2F0D;   {move.l a5,-(a7)  ;push current A5 onto stack}
  52.     
  53. PROCEDURE PopA5;
  54.     INLINE  $2A5F;   {move.l (a7)+,a5  ;pop stack into A5}
  55.     
  56. PROCEDURE   GetMyA5;
  57.     INLINE  $2A52;   {movea.l (a2),a5  ;move apps a5 (pointed to by a2) into a5}
  58.     
  59. FUNCTION    GetCurA5:longint;
  60.     INLINE  $2E8D;
  61.  
  62. FUNCTION   GetADBData:longint;
  63.     INLINE  $2E90;   {move.l (a0),(a7) ;move ADB Data onto stack}
  64.  
  65.     {------------------------------------------------------------------------------------}
  66.  
  67. PROCEDURE ADBComplete;
  68.             
  69. BEGIN
  70.         
  71.     PushA5;
  72.     GetMyA5;
  73.              R3Data := GetADBData;
  74.     Count := Count + 1;
  75.              CompTrue := True;
  76.              PopA5;
  77.             
  78. END;
  79.  
  80.     {------------------------------------------------------------------------------------}
  81.                                                 
  82. BEGIN                              {main PROGRAM}
  83.     
  84.     gotADB := false; {assume no ADB, and just exit if none}
  85.     err:= SysEnvirons (1,TheWorld);
  86.     if err = noerr then
  87.     begin
  88.         case theworld.machineType of
  89.          0,1,2 : begin
  90.                     gotADB := false;
  91.                     Writeln ('Yes, we have no ADB today.');
  92.                     Writeln ('Press the mouse button to exit.');
  93.                     repeat until button;
  94.             end;
  95.          Otherwise gotADB := True;
  96.         end; {case}
  97.     end
  98.     else
  99.     begin
  100.         writeln ('SysEnvirons error = ',err);
  101.         writeln ('Please press the mouse button to exit');
  102.         repeat until button;
  103.     end;
  104.     If gotADB then
  105.     BEGIN
  106.         MyA5 := GetCurA5;
  107.               NumDevs := countADBs;
  108.               writeln ('there are ',NumDevs,' ADB devices on this machine');
  109.               writeln ('');
  110.         
  111.               repeat
  112.         writeln ('press mouse to continue');
  113.         writeln ('');
  114.         repeat until button;
  115.         comptrue := false;
  116.                  Addrs := GetIndADB (DevBlock, NumDevs);
  117.                  Case DevBlock.origADBAddr of
  118.                   3 : Writeln ('Mouse');
  119.                   2 : Begin
  120.                                   Case DevBlock.devType of 
  121.                                   1 : Begin
  122.                                                    Writeln ('Apple Standard KeyBoard');
  123.                                                    GotLEDs := false;
  124.                                             end;
  125.                                   2 : Begin
  126.                                                    Writeln ('Apple Extended KeyBoard');
  127.                                                    GotLEDs := true;
  128.                                             end;
  129.                                   end; {case}
  130.                            end;
  131.                  end; {case}
  132.                        CmdNum := ((Addrs*16)+$0F);  {Device Address X, Talk command, Register 3}
  133.                           ADBData[0] := Char($00);
  134.                           ADBData[1] := Char($00);
  135.                           ADBData[2] := Char($00);
  136.                           err := ADBOp (@MyA5, @ADBComplete,@ADBData, CmdNum);
  137.         if err = noerr then
  138.         begin
  139.             count := 0;
  140.             repeat
  141.                 count := count + 1;         {timeout check}
  142.                 if count = 10000 then
  143.                 begin
  144.                     err := 500;
  145.                     comptrue := true;
  146.                 end
  147.             until comptrue;
  148.             ParseData := fourBytes(R3Data);
  149.         end;
  150.         if err <> noerr then Writeln ('ADBOp error = ',err);
  151.  
  152.                  Writeln ('Device = ',numdevs,' ; Device type = ',DevBlock.devType);
  153.                  Writeln ('ADB Address = ',Addrs,' ; Original Address = ',DevBlock.origADBAddr);
  154.         Writeln ('Routine Pointer = ',longint (DevBlock.dbServiceRtPtr),
  155.                     ' ;Data Area Address = ',longint (DevBlock.dbDataAreaAddr));
  156.         Writeln ('Handler ID = ',integer(ParseData[2]));
  157.                  writeln ('');
  158.                  NumDevs := NumDevs - 1;
  159.               until NumDevs = 0;
  160.                  Writeln ('Press Mouse to quit');
  161.         repeat until button;
  162.     END;
  163.         END.